home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #1 / Amiga Plus CD - 1997 - No. 01.iso / pd / programmierung / oberonv4 / demos / xyplane.mod (.txt) < prev   
Oberon Text  |  1996-03-24  |  3KB  |  87 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. MODULE XYplane;  
  4. (* Graphic output to screen, Input from keyboard, page 91, 100, 311 *)
  5. IMPORT Display, MenuViewers, Oberon, TextFrames, Input;
  6. CONST 
  7.     max = 32768;  closed = 0;  displayed = 2;
  8.     black = Display.black;  white = Display.white;  replace = Display.replace;
  9.     erase* = 0;  draw* = 1; (* values for parameter mode in Dot *)
  10. TYPE 
  11.     XYframe = POINTER TO XYframeDesc;
  12.     XYframeDesc = RECORD (Display.FrameDesc) END;
  13.     F: XYframe;  V: MenuViewers.Viewer;
  14.     bitmap: ARRAY max OF SET;
  15.     X*, Y*, W*, H*: INTEGER;
  16. PROCEDURE Modify(F: XYframe; VAR M: MenuViewers.ModifyMsg);
  17. BEGIN
  18.     IF (M.id = MenuViewers.extend) & (M.dY > 0) THEN
  19.         Display.ReplConst(black, F.X, F.Y + F.H, F.W, M.dY, replace)
  20.     END;
  21.     IF M.Y < F.Y THEN
  22.         Display.ReplConst(black, F.X, M.Y, F.W, F.Y - M.Y, replace)
  23.     END;
  24.     X := F.X;  Y := M.Y;  W := F.W;  H := M.H
  25. END Modify;
  26. PROCEDURE XYhandle*(F: Display.Frame; VAR M: Display.FrameMsg);
  27. BEGIN
  28.     WITH F: XYframe DO
  29.         IF M IS Oberon.InputMsg THEN
  30.             WITH M: Oberon.InputMsg DO
  31.                 IF M.id = Oberon.track THEN
  32.                     Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y)
  33.                 END
  34.             END
  35.         ELSIF M IS MenuViewers.ModifyMsg THEN
  36.             WITH M: MenuViewers.ModifyMsg DO
  37.                 Modify(F, M)
  38.             END
  39.         END
  40.     END 
  41. END XYhandle;
  42. PROCEDURE Clear*;
  43. VAR j: LONGINT;
  44. BEGIN
  45.     Display.ReplConst(black, F.X, F.Y, F.X + F.W, F.Y + F.H, replace);
  46.     j := 0;  WHILE j < max DO  bitmap[j] := {}; INC(j) END
  47. END Clear;
  48. PROCEDURE Open*;
  49. VAR menuF: TextFrames.Frame;  x, y: INTEGER;  
  50. BEGIN
  51.     IF V.state # displayed THEN
  52.         Oberon.OpenTrack(Display.Left, 0);
  53.         menuF := TextFrames.NewMenu("XY Plane", "System.Close");
  54.         NEW(F);  F.handle := XYhandle;
  55.         Oberon.AllocateUserViewer(Display.Left, x, y);
  56.         V := MenuViewers.New(menuF, F, TextFrames.menuH, x, y)
  57.     END;
  58.     Clear
  59. END Open;
  60. PROCEDURE Dot*(x, y, mode: INTEGER);
  61. VAR k, i, j: LONGINT;
  62. BEGIN 
  63.     IF (x >= F.X) & (x < F.X + F.W) & (y >= F.Y) & (y < F.Y + F.H) THEN
  64.         k := LONG(y)*F.W + x;  i := k DIV MAX(SET);  j := k MOD MAX(SET);
  65.         CASE mode OF
  66.               0: Display.Dot(black, x, y, replace); EXCL(bitmap[i], j)
  67.             |1: Display.Dot(white, x, y, replace); INCL(bitmap[i], j)
  68.         END
  69. END Dot;
  70. PROCEDURE IsDot*(x, y: INTEGER): BOOLEAN;
  71. VAR k, i, j: LONGINT;
  72. BEGIN
  73.     IF (x >= F.X) & (x < F.X + F.W) & (y >= F.Y) & (y < F.Y + F.H) THEN
  74.         k := LONG(y)*F.W + x;  i := k DIV MAX(SET);  j := k MOD MAX(SET);  
  75.         IF j IN bitmap[i] THEN RETURN TRUE  ELSE RETURN FALSE END
  76.     ELSE RETURN FALSE
  77. END IsDot;
  78. PROCEDURE Key*(): CHAR;
  79. VAR ch: CHAR;
  80. BEGIN  ch := 0X;
  81.     IF Input.Available() > 0 THEN  Input.Read(ch)  END;
  82.     RETURN ch
  83. END Key;
  84. BEGIN  
  85.     NEW(F);  F.H := 0;  NEW(V);  V.state := closed; 
  86. END XYplane.    (* Copyright M. Reiser, 1992 *)
  87.